home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / HardwareProjects / VideoText.lha / VideoText4.2 / source / datei.p < prev    next >
Encoding:
Text File  |  1995-06-26  |  9.7 KB  |  320 lines
  1. UNIT datei; {$project vt}
  2. { Dateioperationen zum Programm VideoText }
  3.  
  4. INTERFACE; FROM vt USES bildschirm;
  5.  
  6. VAR iconpath: Str80;
  7.  
  8. FUNCTION filetype(name: Str80): Integer;
  9. FUNCTION getpages(filename: Str80): Integer;
  10. FUNCTION savepage(seite: p_onepage): Boolean;
  11. FUNCTION printpage(seite: p_onepage): Boolean;
  12. FUNCTION iffdump: Boolean;
  13. FUNCTION save_action(seite: p_onepage; mode: Integer): Integer;
  14.  
  15. { ---------------------------------------------------------------------- }
  16.  
  17. IMPLEMENTATION;
  18. {$ opt q,s+,i+} { keine Laufzeitprüfungen außer Stack und Feldindizes }
  19.  
  20. CONST STITLE = $0040; { C6 }
  21.       HEADLN = $0020; { C5 }
  22.  
  23. FUNCTION filetype{(name: Str80): Integer};
  24. { Typcodierung: }
  25. { -1: Datei existiert nicht }
  26. {  0: unbekannter Typ (vermutlich roher ASCII-Text) }
  27. {  1: programmeigener Typ 'VTPG'=$56545047 }
  28. {  2: AmigaDOS-Programmdatei $000003F3 }
  29. {  3: IFF-Datei 'FORM'=$464F524D }
  30. {  4: Workbench-Icon $E310 }
  31. VAR head: Long;
  32.     i: Integer;
  33.     ch: Char;
  34.     datei: Text;
  35. BEGIN
  36.   Reset(datei,name);
  37.   IF IOresult=0 THEN BEGIN
  38.     filetype := 0;
  39.     head := 0;
  40.     FOR i := 1 TO 4 DO BEGIN
  41.       Read(datei,ch);
  42.       head := head SHL 8 + Ord(ch);
  43.       IF (i=2) AND (head=$E310) THEN filetype := 4;
  44.     END;
  45.     IF head=$56545047 THEN filetype := 1;
  46.     IF head=$000003F3 THEN filetype := 2;
  47.     IF head=$464F524D THEN filetype := 3;
  48.     Close(datei);
  49.   END ELSE
  50.     filetype := -1;
  51. END;
  52.  
  53. FUNCTION getpages{(filename: Str80): Integer};
  54. { Alle VT-Seiten aus einer VTPG-Datei einlesen und in die Seitenliste }
  55. { einreihen. Rückgabewert: Anzahl der gelesenen Seiten }
  56. VAR i,j, gelesen: Integer;
  57.     bytes: ^ARRAY[1..41] OF Char;
  58.     datei: Text;
  59.     zeile: Str80;
  60.     seite: p_onepage;
  61.     c: Char;
  62. PROCEDURE findword;
  63. { Hilft, zeile in Worte zu zerlegen. Parameter j: Startpunkt, Ergebnis: }
  64. { i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
  65. BEGIN
  66.   i := j; WHILE (zeile[i]=' ') AND (zeile[i]<>#0) DO Inc(i);
  67.   j := i + 1; WHILE NOT (zeile[j] IN [' ',#0]) DO Inc(j);
  68. END;
  69. BEGIN
  70.   gelesen := 0;
  71.   Reset(datei,filename);
  72.   IF (IOresult<>0) THEN     { Datei existiert nicht }
  73.     Exit;
  74.   Buffer(datei,200);
  75.   WHILE NOT EoF(datei) DO BEGIN
  76.     REPEAT
  77.       ReadLn(datei,zeile);
  78.     UNTIL (zeile='VTPG') OR EoF(datei);
  79.     if zeile='VTPG' THEN BEGIN
  80.       New(seite);
  81.       FOR i := 0 to 23 DO BEGIN
  82.         bytes := Ptr(^seite^.chars[40*i]);
  83.         BlockRead(datei,bytes^,40);
  84.         ReadLn(datei);
  85.       END;
  86.       ReadLn(datei,zeile); j := 1;
  87.       findword; seite^.pg := hexval(Copy(zeile,i,j-i));
  88.       findword; seite^.sp := hexval(Copy(zeile,i,j-i));
  89.       findword; seite^.cbits := hexval(Copy(zeile,i,j-i));
  90.       ins_to_list(seite); Inc(gelesen);
  91.     END;
  92.   END;
  93.   Close(datei);
  94.   getpages := gelesen;
  95. END;
  96.  
  97. FUNCTION savepage{(seite: p_onepage): Boolean};
  98. { Seite abspeichern, ASCII oder rohes VT-Format }
  99. { ASCII-Text wird für Untertitel und Schlagzeilen 'komprimiert' ausgegeben: }
  100. { nur die auf der Seite befindliche Box (mindestens aber eine Leerzeile, bei }
  101. { Schlagzeilen zusätzlich die Kopfzeile). }
  102. { Bei Untertiteln werden die Farbsteuerzeichen in Klartext umgesetzt. }
  103. VAR i, zeile: Integer;
  104.     s: str80;
  105.     bytes: ^ARRAY [1..41] OF Char;
  106.     datei: Text;
  107.     is_stitle,is_headln,visible: Boolean;
  108. BEGIN
  109.   savepage := False; IF seite=Nil THEN Exit;
  110.   IF overwrite THEN
  111.     Rewrite(datei,outputname)
  112.   ELSE BEGIN
  113.     Reset(datei,outputname);
  114.     IF (IOresult<>0) THEN { Datei existiert vermutlich nicht }
  115.       Rewrite(datei,outputname);
  116.   END;
  117.   IF IOresult<>0 THEN     { wahrscheinlich 'Object in use' }
  118.     Exit;
  119.   IF withicon THEN IF FileSize(datei)=0 THEN BEGIN
  120.     IF asciifile THEN  s := iconpath + 'ASCII'
  121.     ELSE  s := iconpath + 'VT';
  122.     create_icon(s,outputname);
  123.   END;
  124.   Buffer(datei,500);
  125.   Seek(datei,FileSize(datei));
  126.   IF asciifile THEN BEGIN  { ASCII-Textausgabe }
  127.     is_stitle := (seite^.cbits AND STITLE)<>0;
  128.     is_headln := (seite^.cbits AND HEADLN)<>0;
  129.     FOR zeile := 0 to 23 DO BEGIN
  130.       IF is_stitle OR is_headln THEN BEGIN
  131.         visible := False;
  132.         FOR i := 0 TO 39 DO
  133.           IF (seite^.chars[zeile*40+i]=11) THEN visible := True;
  134.         IF is_headln AND (zeile=0) THEN
  135.           visible := True;
  136.       END ELSE
  137.         visible := True;
  138.       IF visible THEN BEGIN
  139.         makeascii(seite, zeile, NOT is_stitle, s);
  140.         WriteLn(datei, s);
  141.       END;
  142.     END;
  143.     WriteLn(datei);
  144.   END ELSE BEGIN   { (beinahe) rohes VT-Format }
  145.     WriteLn(datei,'VTPG');
  146.     FOR zeile := 0 to 23 DO BEGIN
  147.       bytes := Ptr(^seite^.chars[40*zeile]);
  148.       BlockWrite(datei,bytes^,40);
  149.       WriteLn(datei);
  150.     END;
  151.     Write(datei,hexstr(seite^.pg,0)); Write(datei,' ');
  152.     Write(datei,hexstr(seite^.sp,0)); Write(datei,' $');
  153.     Write(datei,hexstr(seite^.cbits,4)); WriteLn(datei);
  154.   END;
  155.   Close(datei);
  156.   savepage := True;
  157. END;
  158.  
  159. FUNCTION printpage{(seite: p_onepage): Boolean};
  160. { Druckerausgabe, simpelste Ausführung }
  161. VAR drucker: Text;
  162.     i: Integer;
  163.     s: Str80;
  164.     monster: ^String[1000]
  165. BEGIN
  166.   printpage := False;
  167.   Reset(drucker,'PRT:');
  168.   IF IOResult<>0 THEN Exit;
  169.   New(monster); monster^ := '';
  170.   FOR i := 0 TO 23 DO BEGIN
  171.     makeascii(seite, i, True, s);
  172.     monster^ := monster^ + s + Chr(10);
  173.   END;
  174.   Write(drucker,monster^);
  175.   Dispose(monster);
  176.   Close(drucker); printpage := True;
  177. END;
  178.  
  179. FUNCTION iffdump{: Boolean};
  180. { IFF-Bild erzeugen }
  181. VAR i, j, k, zeile, bunt, packbar: Integer;
  182.     l: Long;
  183.     s: str80;
  184.     bytes: ^ARRAY [1..41] OF Char;
  185.     datei: Text;
  186. PROCEDURE putshort(w: Word);
  187.   BEGIN Write(datei,chr(Hi(w)),chr(Lo(w))); END;
  188. PROCEDURE putlong(l: Long);
  189.   BEGIN putshort(Word(l SHR 16)); putshort(Word(l AND $FFFF)); END;
  190. BEGIN
  191.   iffdump := False;
  192.   Rewrite(datei,iffpicname);
  193.   IF IOresult<>0 THEN     { wahrscheinlich 'Object in use' }
  194.     Exit;
  195.   IF withicon THEN BEGIN
  196.     s := iconpath + 'IFF';
  197.     create_icon(s,iffpicname);
  198.   END;
  199.   { IFF-ILBM erzeugen, LoRes, 320x256, 3 Bitplanes }
  200.   Write(datei,'FORM'); putlong(10084);  { wird später korrigiert }
  201.   Write(datei,'ILBM');
  202.   Write(datei,'BMHD'); putlong(20);
  203.   putshort(320); putshort(216); { Breite, Höhe der Bitmap }
  204.   putshort(0); putshort(0); { x/y-Offset }
  205.   Write(datei,Chr(3)); { 3 Bitplanes }
  206.   Write(datei,Chr(0)); { keine Maske }
  207.   Write(datei,Chr(1)); { Grafikdaten mit Byte-Running gepackt !!! }
  208.   Write(datei,Chr(0)); { Füllbyte }
  209.   putshort(0); { transparente Farbe }
  210.   Write(datei, Chr(10), Chr(11));  { x/y-Verhältnis ~1:1 }
  211.   putshort(320); putshort(256); { Breite, Höhe des Bildschirms }
  212.   Write(datei,'CMAP'); putlong(24);
  213.   FOR i := 0 TO 7 DO
  214.     FOR j := 0 TO 7 DO
  215.       IF (colperm SHR (4*(7-j))) AND $F = i THEN
  216.         Write(datei,Chr($F0*(j AND 1)),Chr($78*(j AND 2)),
  217.                         Chr($3C*(j AND 4)));
  218.   Write(datei,'CAMG'); putlong(4);
  219.   putlong(0);  { ViewMode: weder HIRES noch LACE! }
  220.   Write(datei,'BODY'); putlong(10000);    { Wert wird später korrigiert }
  221.   FOR zeile := 0 TO 215 DO BEGIN
  222.     FOR i := 0 TO 2 DO BEGIN
  223.       bytes := Ptr(Long(bitmapzeile(i,zeile))+39);
  224.       { Zeile von bytes[] nach s[] packen (Byte-Running): }
  225.       j := 1; k := 0;
  226.       bunt := 0;
  227.       REPEAT
  228.         packbar := 1;
  229.         WHILE (bytes^[j+packbar]=bytes^[j+packbar-1]) AND (j+packbar<40) DO
  230.           Inc(packbar);
  231.         IF packbar>2 THEN BEGIN { lohnt packen? }
  232.           Inc(k); s[k] := Chr(257-packbar); Inc(k); s[k] := bytes^[j];
  233.           j := j + packbar; bunt := 0;
  234.         END ELSE BEGIN
  235.           Inc(bunt); IF bunt=1 THEN Inc(k);
  236.           Inc(k); s[k] := bytes^[j]; s[k-bunt] := Chr(bunt-1);
  237.           Inc(j);
  238.         END;
  239.       UNTIL j>40;
  240.       BlockWrite(datei,s,k);
  241.     END;
  242.   END;
  243.   { Chunk-Größen korrigieren }
  244.   l := FileSize(datei);
  245.   IF Odd(l) THEN BEGIN Write(datei,Chr(0)); Inc(l); END;
  246.   Seek(datei,4); putlong(l-8);
  247.   Seek(datei,88); putlong(l-92);
  248.   Close(datei);
  249.   iffdump := True;
  250. END;
  251.  
  252. FUNCTION save_action{(seite: p_onepage; mode: Integer): Integer};
  253. { Verwaltungskram für savepage(). }
  254. { Bedeutung von <mode>: }
  255. { 1=nur <seite> speichern, 2=mit allen Unterseiten, 3=ganze Seitenliste }
  256. { Ergebnis: }
  257. { 0: OK, 1: Benutzer wollte nicht, 2: Anhängen unzulässig, 3: IO-Fehler }
  258. VAR ft: Integer;
  259.     save_ovrw: Boolean;
  260.     pg1,pg2: p_onepage;
  261. BEGIN
  262.   save_action := 1;
  263.   IF seite<>Nil THEN BEGIN
  264.     fileinfo;
  265.     IF mode=3 THEN BEGIN { Ctrl-S: *alle* Seiten Speichern }
  266.       mainline; Write('Alle Seiten speichern? ');
  267.       IF NOT ja_nein THEN Exit;
  268.     END;
  269.     ft := filetype(outputname); mainline;
  270.     { Sicherheitsprüfungen: Überschreiben nur mit Bestätigung ... }
  271.     IF overwrite THEN BEGIN
  272.       IF ft<>-1 THEN BEGIN
  273.         Write(']berschreiben - sicher? ');
  274.         IF NOT ja_nein THEN Exit;
  275.       END;
  276.     { ... Anhängen nur an geeignete Dateien: }
  277.     END ELSE BEGIN
  278.       Write(#155'2m');
  279.       IF ft IN [2,3,4] THEN BEGIN
  280.         CASE ft OF
  281.           2: Write('Programmdatei');
  282.           3: Write('IFF-Datei');
  283.           4: Write('Icon-Datei');
  284.         END;
  285.         Write(', Anh{ngen unzul{ssig!');
  286.         save_action := 2; Exit;
  287.       END;
  288.       IF NOT asciifile AND NOT (ft IN [1,-1]) THEN BEGIN
  289.         Write('VT nur an VT-Format anh{ngen!');
  290.         save_action := 2; Exit;
  291.       END;
  292.     END;
  293.     { Alle Rückfragen überstanden -> speichern: }
  294.     busy_pointer; save_ovrw := overwrite;
  295.     pg1 := root;
  296.     WHILE pg1<>NIL DO BEGIN
  297.       IF (mode=3) OR (pg1=seite)
  298.          OR ((mode=2) AND (pg1^.pg=seite^.pg)) THEN BEGIN
  299.         mainline;
  300.         Write('Seite ',hexstr(pg1^.pg,0),'/',hexstr(pg1^.sp,0),' ...');
  301.         IF savepage(pg1) THEN
  302.           Write(' gespeichert.')
  303.         ELSE BEGIN
  304.           mainline; Write(#155'2mDateifehler - sorry!');
  305.           save_action := 3;
  306.           pg1 := Nil;
  307.         END;
  308.         overwrite := False;
  309.       END;
  310.       IF pg1<>Nil THEN pg1 := pg1^.next;
  311.     END;
  312.     normal_pointer; overwrite := save_ovrw;
  313.     save_action := 0;
  314.   END;
  315. END;
  316.  
  317. BEGIN  { Initialisierungen }
  318.   iconpath := 'Icons/';
  319. END.
  320.